home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / ODE / more_utils < prev    next >
Encoding:
Text File  |  1990-06-01  |  1.8 KB  |  89 lines
  1. \ MORE Utilities to support ODE
  2. \
  3. \ Author: Phil Burk
  4. \ Copyright 1986 Phil Burk
  5. \
  6. \ MOD: PLB 12/13/89 Sped up CLIPTO
  7. \ MOD: PLB 4/13/90 Add ?TERMINAL/8
  8.  
  9. include? toupper ju:char-macros
  10.  
  11. ANEW TASK-MORE_UTILS
  12.  
  13. hex
  14. : NFA.MOVE ( nfa addr -- , copy name field to address and fix like string )
  15.     >r count 1f and ( n+1 c ,  remove immediate bit )
  16.     dup r@ c! ( set length at pad )
  17.     r> 1+ rot rot 0 ( a+1 n+1 c 0 )
  18.     DO
  19.         2dup c@ 7f and  ( remove flags from characters )
  20.         swap c!
  21.         1+ swap 1+ swap ( advance )
  22.     LOOP 2drop
  23. ;
  24.  
  25. : NFA->$ ( nfa -- $string , copy to pad )
  26.     pad nfa.move pad
  27. ;
  28. decimal
  29.  
  30. \ Assistance for debugging.
  31. : BREAK ( -- , dump stack and allow abort )
  32.     .s cr ." BREAK - Enter A to abort" cr
  33.     key toupper ascii A =
  34.     IF abort THEN
  35. ;
  36.  
  37. : BREAK" ( xxxx" -- , give message and break )
  38.     [compile] ."
  39.     compile break
  40. ; immediate
  41.  
  42. \ ?terminal that only happens so often to avoid slowing down system
  43. V: ?term-count
  44. : ?TERMINAL/64  ( -- key? , true if key pressed, sometimes )
  45.     ?term-count @ dup
  46.     1+ 63 AND ?term-count !
  47.     0= IF ?terminal
  48.     ELSE false
  49.     THEN
  50. ;
  51. : ?TERMINAL/8  ( -- key? , true if key pressed, sometimes )
  52.     ?term-count @ dup
  53.     1+ 7 AND ?term-count !
  54.     0= IF ?terminal
  55.     ELSE false
  56.     THEN
  57. ;
  58.  
  59. \ Range checking and clipping tools.
  60. : INRANGE? ( n lo hi -- flag , Is LO <= N <= HI ? )
  61.     2 pick <
  62.     IF 2drop false
  63.     ELSE >=
  64.     THEN
  65. ;
  66.  
  67. : CLIPTO ( n lo hi -- nclipped , clip N to range )
  68.     >r max r> min
  69. ;
  70.  
  71. : BAD.CHAR? ( CHAR -- FLAG , true if non printing)
  72.     32 126 inrange? not
  73. ;
  74.  
  75. : SAFE.EMIT ( char -- , emit if safe or '.' )
  76.     dup bad.char?
  77.     IF drop ascii . emit
  78.     ELSE emit
  79.     THEN
  80. ;
  81.  
  82. : BAD.STR? ( addr count -- , scan string for bad chars)
  83.     0
  84.     DO  dup i + c@ bad.char?
  85.         IF  cr dup i + dup h. c@ h.
  86.         THEN
  87.     LOOP drop
  88. ;
  89.